# $Id: hooks.tcl 36 2007-08-29 17:52:22Z khomoutov $

namespace eval ::dccore {
	namespace eval hooks {
		namespace import ::dccore::*
		variable hooks [list]
	}

	namespace export hook
}

proc ::dccore::hook {option args} {
	switch -- $option {
		new {
			eval hooks::CreateNewHook $args
		}
		add {
			eval hooks::AddHookHandler $args
		}
		run {
			eval hooks::RunHook $args
		}
		default {
			return -code error "bad option \"$option\":\
				must be one of new, add, run or break"
		}
	}
}

proc ::dccore::hooks::CreateNewHook {hook args} {
	variable hooks

	if {[lsearch $hooks $hook] >= 0} {
		return -code error "hook already exists: $hook"
	}

	variable $hook
	upvar 0 $hook state

	foreach {opt val} $args {
		switch -glob -- $opt {
			-subst* { set state(subst) $val }
			default {
				return -code error "unknown option: $opt"
			}
		}
	}

	set state(handlers) [list]

	lappend hooks $hook
}

proc ::dccore::hooks::RunHook {hook args} {
	variable $hook
	upvar 0 $hook state

	debugmsg hook "hook/run: $hook $args"

	if {![info exists state]} return

	foreach handler $state(handlers) {
		lassign $handler script prio iscommand

		if {$iscommand} {
			set cmd [concat $script $args]
		} else {
			if {[info exists state(subst)]} {
				set cmd [eval [list $state(subst) $hook $script $prio] $args]
			} else {
				set cmd [string map [list \
					%%     % \
					%H     [list $hook] \
					%P     [list $prio] \
					%A     [list $args] \
					%a     $args \
				] $script]
			}
		}

		debugmsg hook "hook/script: $hook ($prio) $cmd"

		set res [catch [list namespace inscope :: $cmd] err]
		if {$res == 1} {
			global errorInfo
			return -code error -errorcode [list DCCORE HOOK $hook] \
				-errorinfo $errorInfo $err
		} elseif {$res == 3} {
			break
		}
	}
}

proc ::dccore::hooks::AddHookHandler {hook script args} {
	variable $hook
	upvar 0 $hook state

	if {![info exists state]} {
		CreateNewHook $hook
	}

	set iscommand false
	set prio      50.0

	set opts [normalize_flags $args -iscommand true]
	foreach {opt val} $opts {
		switch -glob -- $opt {
			-iscommand { set iscommand $val }
			-prio*     { set prio $val }
			default {
				return -code error "unknown option: $opt"
			}
		}
	}

	set state(handlers) [lsort -real -index 1 \
		[linsert $state(handlers) end [list $script $prio $iscommand]]]
}

